home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / EarthPng / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-22  |  7.1 KB  |  260 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
  7.  
  8. type
  9.   TForm1 = class(TForm)
  10.     procedure FormPaint(Sender: TObject);
  11.     procedure FormActivate(Sender: TObject);
  12.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  13.     procedure FormCreate(Sender: TObject);
  14.   private
  15.     { Private declarations }
  16.     FGameOver : Boolean;
  17.   public
  18.     { Public declarations }
  19.     backgroundImage : TImage;
  20.     spriteImage : TImage;
  21.     paddle : TImage;
  22.     backgroundCanvas : TCanvas;
  23.     workCanvas : TCanvas;
  24.     backgroundRect, spriteRect, changeRect, paddleRect, changePaddleRect :TRect;
  25.     x, y, xDir, yDir, paddleX, paddleY, paddleCenter, Angle : integer;
  26.     procedure IdleLoop( Sender: TObject; var Done: Boolean );
  27.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.dfm}
  36.  
  37. uses MMSystem;
  38.  
  39. procedure TForm1.FormPaint(Sender: TObject);
  40. begin
  41.   RealizePalette(backgroundCanvas.Handle);
  42.   RealizePalette(workCanvas.Handle);
  43.   Canvas.CopyRect(backgroundRect, workCanvas, backgroundRect);
  44. end;
  45.  
  46. procedure TForm1.FormActivate(Sender: TObject);
  47. var
  48.   backgrounddc, workdc : HDC;
  49.   bkbmp, bmp : HBITMAP;
  50. begin
  51.   backgroundImage := TImage.Create( Self );
  52.   spriteImage := TImage.Create( Self );
  53.   paddle := TImage.Create( Self );
  54.   workCanvas := TCanvas.Create;
  55.   backgroundCanvas := TCanvas.Create;
  56.  
  57.   Angle := 1;
  58.  
  59.   spriteImage.Picture.LoadFromFile('Earth.ico');
  60.   backgroundImage.Picture.LoadFromFile('androm.bmp');
  61.   paddle.Picture.LoadFromFile('paddle.ico');
  62.  
  63.   WindowState := wsMaximized;
  64.  
  65.   backgroundRect.Top := 0;
  66.   backgroundRect.Left := 0;
  67.   backgroundRect.Right :=  ClientWidth;
  68.   backgroundRect.Bottom :=  ClientHeight;
  69.  
  70.  
  71.   spriteRect.Top := 0;
  72.   spriteRect.Left := 0;
  73.   spriteRect.Right := spriteImage.Picture.Width;
  74.   spriteRect.Bottom := spriteImage.Picture.Height;
  75.  
  76.   //Set up backgroundCanvas
  77.   backgrounddc := CreateCompatibleDC(Canvas.Handle);
  78.   bkbmp := CreateCompatibleBitmap(Canvas.Handle, ClientWidth, ClientHeight);
  79.   SelectObject(backgrounddc, bkbmp);
  80.   SelectPalette(backgrounddc, backgroundImage.Picture.Bitmap.Palette, false);
  81.   backgroundCanvas.Handle := backgrounddc;
  82.   backgroundCanvas.StretchDraw( backgroundRect, backgroundImage.Picture.Bitmap);
  83.  
  84.  
  85.   //Set up workCanvas
  86.   workdc := CreateCompatibleDC(Canvas.Handle);
  87.   bmp := CreateCompatibleBitmap(Canvas.Handle, ClientWidth, ClientHeight);
  88.   SelectObject(workdc, bmp);
  89.   SelectPalette(workdc, backgroundImage.Picture.Bitmap.Palette, false);
  90.   workCanvas.Handle := workdc;
  91.   workCanvas.CopyRect(backgroundRect,  backgroundCanvas, backgroundRect);
  92.   workCanvas.Draw( 0, 0, spriteImage.Picture.Icon);
  93.   paddleX := ClientWidth div 2;
  94.   paddleY := ClientHeight - 50;
  95.   workCanvas.Draw( paddleX, paddleY, paddle.Picture.Icon);
  96.  
  97.   paddleRect.Left := paddleX - paddle.Width;
  98.   paddleRect.Right := paddleX + paddle.Width;
  99.   paddleRect.Top    := paddleY;
  100.   paddleRect.Bottom := paddleY + paddle.Height;
  101.  
  102.  
  103.   RealizePalette(backgroundCanvas.Handle);
  104.   RealizePalette(workCanvas.Handle);
  105.   Canvas.CopyRect(backgroundRect, workCanvas, backgroundRect);
  106. end;
  107.  
  108. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  109.   Y: Integer);
  110. begin
  111.   //Animates and moves paddle
  112.   paddleCenter := X;
  113.   if(paddleCenter < paddle.Picture.Width div 2) then
  114.       paddleCenter := paddle.Picture.Width div 2;
  115.   if(paddleCenter > ClientWidth - (paddle.Picture.Width div 2)) then
  116.       paddleCenter := ClientWidth - (paddle.Picture.Width div 2);
  117. end;
  118.  
  119. procedure TForm1.FormCreate(Sender: TObject);
  120. begin
  121.   //Assign idle time function
  122.   Application.OnIdle := IdleLoop;
  123.  
  124.   if(Application.MessageBox('Would you like to play with Earth?', 'Hello Earthling', MB_OKCANCEL) = IDOK) then
  125.   begin
  126.       //load sound effect
  127.       sndPlaySound('Utopia Default.wav', SND_ASYNC or SND_FILENAME);
  128.       x := 0;
  129.       y := 0;
  130.       FGameOver := false;
  131.       ShowCursor(false);
  132.  
  133.   end
  134.   else
  135.       Application.Terminate;
  136. end;
  137.  
  138. procedure TForm1.IdleLoop(Sender: TObject; var Done: Boolean);
  139. var
  140.   choice, SideDef, TopDef, PaddleDifference: integer; 
  141. begin
  142.   //keeps loop going
  143.   done := false;
  144.   //slows down action
  145.   Sleep(1);
  146.  
  147.   changeRect := spriteRect;
  148.   spriteRect.Left := x;
  149.   spriteRect.Top := y;
  150.   spriteRect.Right := x + spriteImage.Picture.Width;
  151.   spriteRect.Bottom := y + spriteImage.Picture.Height;
  152.  
  153.   workCanvas.CopyRect(paddleRect, backgroundCanvas, paddleRect);
  154.  
  155.   changePaddleRect := paddleRect;
  156.   paddleRect.Left := paddleCenter - ((paddle.Picture.Width) div 2);
  157.   paddleX := paddleRect.Left;
  158.   paddleRect.Top := paddleY;
  159.   paddleRect.Right := paddleX + paddle.Picture.Width;
  160.   paddleRect.Bottom := paddleY + paddle.Picture.Height;
  161.  
  162.   SideDef := changeRect.Left - spriteRect.Left;
  163.   // If SideDiff < 0 the paddle is to the right
  164.   if(SideDef < 0) then
  165.   begin
  166.     changeRect.Right := spriteRect.Right;
  167.   end
  168.   else
  169.   begin
  170.     changeRect.Left := spriteRect.Left;
  171.   end;
  172.  
  173.   TopDef := changeRect.Top - spriteRect.Top;
  174.   // If SideDiff < 0 the paddle is to the Down
  175.   if(TopDef < 0) then
  176.   begin
  177.     changeRect.Bottom := spriteRect.Bottom;
  178.   end
  179.   else
  180.   begin
  181.     changeRect.Top := spriteRect.Top;
  182.   end;
  183.  
  184.   workCanvas.CopyRect(spriteRect, backgroundCanvas, spriteRect);
  185.  
  186.  
  187.   //ChangeRectCalcs
  188.   if (y <= 0) then
  189.   begin
  190.     yDir := 5;
  191.   end;
  192.   if (y >= ClientHeight - 16) then
  193.   begin
  194.     FGameOver := true;
  195.     SetCursor(HCURSOR( IDC_ARROW ));
  196.     ShowCursor(true);
  197.     choice := MessageBox(Handle, 'You lost Earth', 'Try Again?', MB_RETRYCANCEL);
  198.     if(choice = IDRETRY) then
  199.     begin
  200.       x := 0;
  201.       y := 0;
  202.       ShowCursor(false);
  203.     end
  204.     else
  205.       Form1.Close;
  206.   end;
  207.  
  208.   if ( (spriteRect.Bottom - 16) >= (paddleRect.Top) )
  209.    and ( (spriteRect.Bottom - 16) <= (paddleRect.Top + 5) )
  210.    and ( (spriteRect.Right) >= (paddleRect.Left) )
  211.    and ( (spriteRect.Left) <= (paddleRect.Right) ) then
  212.   begin
  213.     yDir := -5;
  214.     sndPlaySound('Utopia Default.wav', SND_ASYNC or SND_FILENAME);
  215.   end;
  216.  
  217.   if (x <= 0) then
  218.   begin
  219.     xDir := 5;
  220.   end;
  221.  
  222.   if(x >= ClientWidth - 16) then
  223.   begin
  224.     xDir := -5;
  225.   end;
  226.  
  227.   inc ( x , xDir );
  228.   inc ( y , yDir );
  229.  
  230.   PaddleDifference := changePaddleRect.Left - paddleRect.Left;
  231.   // If PaddleDiff < 0 the paddle is to the right
  232.   if(PaddleDifference < 0) then
  233.   begin
  234.     changePaddleRect.Right := paddleRect.Right;
  235.   end
  236.   else
  237.   begin
  238.     changePaddleRect.Left := paddleRect.Left;
  239.   end;
  240.  
  241.   //Perform dirty rectangle animation on memory and Form canvas
  242.   workCanvas.Draw(x, y, spriteImage.Picture.Icon);
  243.   workCanvas.Draw(paddleX, paddleY, paddle.Picture.Icon);
  244.   RealizePalette(backgroundCanvas.Handle);
  245.   RealizePalette(workCanvas.Handle);
  246.   Canvas.CopyRect(changeRect, workCanvas, changeRect);
  247.   Canvas.CopyRect(changePaddleRect, workCanvas, changePaddleRect);
  248. end;
  249.  
  250. procedure TForm1.WMSetCursor(var Message: TWMSetCursor);
  251. begin
  252.   //Hides Cursor
  253.   if not(FGameOver) then
  254.   begin
  255.     SetCursor( HCURSOR( nil ) );
  256.   end;
  257. end;
  258.  
  259. end.
  260.